home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 20
/
Cream of the Crop 20 (Terry Blount) (1996).iso
/
program
/
vol15n11.zip
/
TBWIZ.ZIP
/
TBSAVE~1.FRM
< prev
next >
Wrap
Text File
|
1996-02-09
|
9KB
|
310 lines
VERSION 4.00
Begin VB.Form tbSaveForm
BorderStyle = 3 'Fixed Dialog
Caption = "Save Toolbar"
ClientHeight = 1590
ClientLeft = 2850
ClientTop = 3315
ClientWidth = 4515
ControlBox = 0 'False
Height = 1995
Left = 2790
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1590
ScaleWidth = 4515
ShowInTaskbar = 0 'False
Top = 2970
Width = 4635
Begin VB.CommandButton Command2
Caption = "Cancel"
Height = 270
Left = 3480
TabIndex = 6
Top = 720
Width = 975
End
Begin VB.CommandButton Command1
Caption = "&Save"
Height = 270
Left = 3480
TabIndex = 5
Top = 240
Width = 975
End
Begin VB.Frame Frame1
Caption = "Select controls:"
Height = 1335
Left = 120
TabIndex = 0
Top = 120
Width = 3135
Begin VB.ComboBox Combo1
Height = 315
Index = 1
Left = 1065
TabIndex = 4
Text = "Combo1"
Top = 840
Width = 1815
End
Begin VB.ComboBox Combo1
Height = 315
Index = 0
Left = 1065
TabIndex = 2
Text = "Combo1"
Top = 360
Width = 1815
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "ImageList:"
Height = 195
Index = 1
Left = 240
TabIndex = 3
Top = 860
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Toolbar:"
Height = 195
Index = 0
Left = 360
TabIndex = 1
Top = 390
Width = 585
End
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 3720
Top = 1080
_Version = 65536
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
CancelError = -1 'True
DefaultExt = "*.tbr"
DialogTitle = "Save Toolbar"
Filter = "*.tbr | Toolbars"
End
End
Attribute VB_Name = "tbSaveForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
DefInt A-Z
Function SaveTB() As Integer
'*** ACTIVE PROJECT INFO
'Dim ProjectFilename$, ProjectDirty As Boolean
'ProjectFilename$ = gobjIDEAppInst.ActiveProject.FileName
'ProjectDirty = gobjIDEAppInst.ActiveProject.IsDirty
'Debug.Print ProjectFilename$
'Debug.Print ProjectDirty
'*** ACTIVE FORM INFO
'****ACTIVE FORM NAME (FORM2)
'gobjIDEAppInst.ActiveProject.ActiveForm.Properties.Item("Name")
'****ACTIVE FORM file count
'gobjIDEAppInst.ActiveProject.Components.Item(ssc%).FileCount
'****Names of ACTIVE FORM files
'gobjIDEAppInst.ActiveProject.Components.Item(ssc%).FileNames(ssfiles%)
'Dim ss As Object, ssc%, ssfiles%
'Set ss = gobjIDEAppInst.ActiveProject.Components
'For ssc% = 0 To ss.Count - 1
' If ss.Item(ssc%).Name = gobjIDEAppInst.ActiveProject.ActiveForm.Properties.Item("Name") Then'
' For ssfiles% = 0 To ss.Item(ssc%).FileCount - 1
' Debug.Print ss.Item(ssc%).FileNames(ssfiles%)
' Next
' End If
'Next
'setup
Dim ProjectFilename$, ProjectDirty As Boolean
Dim CurrFormName$, CurrFormFiles$(1)
Dim i%, ii%
Dim success As Boolean
'get project info
'ProjectFilename$ = gobjIDEAppInst.ActiveProject.FileName
'ProjectDirty = gobjIDEAppInst.ActiveProject.IsDirty
'get form info
With gobjIDEAppInst.ActiveProject
CurrFormName$ = .ActiveForm.Properties.Item("Name")
With .Components
For i% = 0 To .Count - 1
If .Item(i%).Name = CurrFormName$ Then
CurrFormFiles$(0) = .Item(i%).FileNames(0)
CurrFormFiles$(1) = .Item(i%).FileNames(1)
' Debug.Print CurrFormFiles$(0)
' Debug.Print CurrFormFiles$(1)
End If
Next
End With
End With
If CurrFormFiles$(0) = "" Or (Len(CurrFormFiles$(0)) = 0) Then
Alert "Save form file first!"
SaveTB = -1
Exit Function
End If
On Error Resume Next
CommonDialog1.ShowSave
If Err = cdlCancel Then SaveTB = 0: Exit Function
On Error GoTo 0
gfnameTBFile = CommonDialog1.FileName
Screen.MousePointer = HOURGLASS
'MsgBox ExtractFileRoot(gfnameTBFile)
'how about saveas to a temp
'then kill the temp
Dim Source$
Source$ = CurrFormFiles$(0)
Dim linetest$
Dim Targ$
Dim tbEvent$
Dim icTest$, tbTest$
Dim Terminator$
icTest$ = "ImageList " & Combo1(1)
tbTest$ = "Toolbar " & Combo1(0)
tbEvent$ = Combo1(0) & "_"
'copy code to tbr file
Targ$ = ExtractFilePath$(gfnameTBFile) + ExtractFileRoot(gfnameTBFile) + ".tbr"
Terminator$ = "End"
Open Targ$ For Output As #1 ' Open file for output.
Open Source$ For Input As #2
Do While Not EOF(2)
Line Input #2, linetest$
If (InStr(linetest$, icTest$) > 0) Or (InStr(linetest$, tbTest$) > 0) Then
Print #1, linetest$
Do
Line Input #2, linetest$
Print #1, linetest$
Loop Until Trim$(linetest$) = Terminator$
End If
Loop
Close #2
'now let's get the events
Terminator$ = "End Sub"
Print #1, "TB_EVENTS"
Open Source$ For Input As #2
Do While Not EOF(2)
Line Input #2, linetest$
If InStr(linetest$, tbEvent$) > 0 Then 'toolbar event
Print #1, linetest$
Do
Line Input #2, linetest$
Print #1, linetest$
Loop Until Trim$(linetest$) = Terminator$
End If
Loop
Close #2
Close #1
'Copy frx file
Targ$ = ExtractFilePath$(gfnameTBFile) + ExtractFileRoot(gfnameTBFile) + ".frx"
FileCopy ExtractFilePath$(Source$) + ExtractFileRoot(Source$) + ".frx", Targ$
'gfnameTBFilef
SaveTB = 1
Exit Function
'**** REMOVE A FORM
' Debug.Print .RemoveComponent(MyForm, True)
' Debug.Print .AddFile(CurrFormFiles$(0))
' With .Components
' For i% = 0 To .Count - 1
' If .Item(i%).Name = CurrFormName$ Then
' Debug.Print "reloading..."
' .Item(i%).Reload
' End If
' Next
' End With
'**** RELOAD A FORM
' .Item(i%).Reload
'can't remove and reload
'so can't take advantage of saving w/removing when reloading unless...remove/add then make changes then reload
' *** ADD A FORM
' Debug.Print .AddFile(CurrFormFiles$(0))
'End With
'Exit Sub
Dim testControl As Object, MyControl As Object, MyProperty As Object
Dim j%
For i = 0 To gobjIDEAppInst.ActiveProject.ActiveForm.ControlTemplates.Count - 1
'Debug.Print VBInstance.ActiveProject.ActiveForm.ControlTemplates(i)
Set testControl = gobjIDEAppInst.ActiveProject.ActiveForm.ControlTemplates(i)
If testControl.Properties.Item("Name") = "Toolbar1" Then
For j = 0 To testControl.Properties.Count - 1
Set MyProperty = testControl.Properties(j)
' Debug.Print " Name: "; MyProperty.Name
' Debug.Print " Type: "; MyProperty.Type
' Debug.Print " Value: "; TypeName(MyProperty.Value)
' Debug.Print MyProperty.Value
Next j
End If
Set MyProperty